home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / self / contrib.lha / contrib / 491 / aa / buttons.self < prev    next >
Encoding:
Text File  |  1993-07-22  |  5.6 KB  |  252 lines
  1. " object to control updating of AA window "
  2. "
  3. *
  4. * buttons.self,v 1.1 1993/07/22 00:15:14 richards Exp
  5. *
  6. * buttons.self,v
  7. # Revision 1.1  1993/07/22  00:15:14  richards
  8. # Moved back to having event handlers per operation.
  9. # eventHandler/buttons now support substitution.
  10. # poly.self has primitive substitution handler, except that it has
  11. # no concept of context.
  12. #
  13. *
  14. *
  15. **************************
  16. *****  BUTTONS        ****
  17. **************************
  18. "
  19.  
  20. " :=(ADDSLOTS)=: "
  21. aa _AddSlotsIfAbsent: (| views* = (). |)
  22. aa views _AddSlotsIfAbsent: (| traits = () |)
  23. aa views _AddSlotsIfAbsent: (| prototypes* = () |)
  24.  
  25. " :=(TRAITS DEFINITIONS)=:aa views "      
  26. aa views traits _AddSlotsIfAbsent: ( |
  27.     actionButton      = ().
  28.     textButton        = ().
  29.     imageButton          = ().
  30.     editorButtons     = ().
  31. |)
  32.  
  33. aa views prototypes _AddSlotsIfAbsent: (|
  34.     actionButton      = ().
  35.     textButton          = ().
  36.     imageButton          = ().
  37.     editorButtons     = ().
  38. |)
  39.  
  40. aa views traits actionButton _Define: (|
  41.     _ parent** = traits view.
  42.  
  43.     copySelector: s = (|c| c: copy. c).
  44.     copySelector: s Label: l = (|c|
  45.     c: copy.
  46.     c label: l. c
  47.     ).
  48.  
  49.     "override parameters"
  50.     leftMargin = 1.
  51.     topMargin = 1.
  52.  
  53.     "_" copyUnrealised: sv = (|c| 
  54.     c: resend.copyUnrealised: sv.
  55.     c selected: false. 
  56.     c
  57.     ).
  58.  
  59.     calculateSubViewSize = (42).
  60.     recalculateSubViewSize = ( calculateSubViewSize ). 
  61.  
  62.     fixUpSuperViewSlots = (
  63.     superView buttons at: buttonNum Put: self.
  64.     ).
  65.  
  66.     realise: v = (
  67.     selected: false.
  68.     resend.realise: v.
  69.     calculateSubViewSize.
  70.     self
  71.     ).
  72.  
  73.     enterNotify: event = (selected: true. drawModel).
  74.     leaveNotify: event = (selected: false. drawModel).
  75.  
  76.     selectUp: pt = (
  77.     selected ifTrue: [|t|
  78.         selected: false.
  79.         drawModel. flush.
  80.         
  81.         performAction.
  82.  
  83.         selected: true.
  84.         drawModel. flush.
  85.     ].
  86.     ).
  87.  
  88.     performAction = (printLine).
  89.  
  90.     redraw = (ifRealised: [drawModel]).
  91.  
  92.     ^ drawModel = (
  93.     |fg. bg|
  94.     
  95.     selected ifTrue: [fg: manager gcb. bg: manager gc]
  96.           False: [fg: manager gc. bg: manager gcb].
  97.  
  98.         "background"
  99.         window fillRectangle: (0@0)##(width@@height) GC: bg.
  100.     
  101.     drawContents: fg BG: bg.
  102.     self
  103.     ).
  104.  
  105. |)
  106.  
  107.  
  108. aa views prototypes actionButton _Define: view 
  109. aa views prototypes actionButton _AddSlots: (|
  110.     _ parent* = aa views traits actionButton.
  111.     _ iName <- 'actionButton'.
  112.     iArea <- (10@350)##(10@@10).
  113.     buttonNum <- 1.    
  114.     selected <- false.
  115. |)
  116.  
  117. aa views prototypes actionButton eventMaskAdd: xlib events buttonReleaseMask 
  118. aa views prototypes actionButton eventMaskAdd: xlib events buttonPressMask 
  119. aa views prototypes actionButton eventMaskAdd: xlib events enterWindowMask
  120. aa views prototypes actionButton eventMaskAdd: xlib events leaveWindowMask
  121.  
  122.  
  123. aa views traits textButton _Define: (|
  124.     _ parent*                 = aa views traits actionButton.
  125.     ^ copy = (|c|
  126.     c: resend.copy.
  127.     c
  128.     ).
  129.  
  130.     printString = (
  131.     '<textButton>Label: ',label
  132.     ).
  133.         
  134.     calculateSubViewSize = (
  135.     ifRealised: [
  136.         area: (area origin)##(((textWidth: caption) + leftMargin double)@@
  137.               (topMargin double + textHeight: caption))
  138.     ].
  139.     ).
  140.  
  141.     _ drawContents: fg BG: bg = (
  142.     window drawString: caption
  143.           At: leftMargin@(topMargin + textAscent: caption) 
  144.           GC: fg.
  145.     ).
  146.  
  147.     ^ label: s = (
  148.     iLabel: s.
  149.     calculateSubViewSize.
  150.     redraw
  151.     ).
  152.     ^ label = (iLabel).
  153.  
  154.     ^ caption = (iLabel).
  155. |)
  156.  
  157. aa views prototypes textButton _Define: aa views actionButton
  158. aa views prototypes textButton _AddSlots: (|
  159.     _ parent*                 = aa views traits textButton.
  160.     iLabel <- 'myButton'.
  161. |)
  162.  
  163. aa views traits imageButton _Define: (|
  164.     _ parent*                 = aa views traits actionButton.
  165.     ^ copy = (| c. |
  166.     c: resend.copy.
  167.     c
  168.     ).
  169.  
  170.     ^ realise = (| c. |
  171.     resend.realise.
  172.     suckBitmap.
  173.     ).
  174.     
  175.     ^ printString = (
  176.     '<imageButton>Bitmap: ',bitmapName
  177.     ).
  178.  
  179.     ^ drawContents: fg BG: bg = (
  180.     bitmap isNil ifFalse: [
  181.         bitmap drawOn: window GC: fg At: 0@0.
  182.     ].
  183.     self
  184.     ).
  185.     
  186.     ^ suckBitmap = (
  187.     bitmap: manager findBitmap: bitmapName Window: window.
  188.     ).
  189.  
  190.     ^ bitmapName: bm = (
  191.     iBitmapName: bm.
  192.     ifRealised: [ suckBitmap. ].
  193.     ).
  194.  
  195.     ^ bitmapName = ( iBitmapName ).
  196.  
  197.     ^ calculateSubViewSize = (
  198.     (isRealised && (bitmap isNil not)) ifTrue: [
  199.         area: (area origin)##(bitmap size).
  200.     ].
  201.     ).
  202. |)
  203.  
  204. aa views prototypes imageButton _Define: aa views actionButton
  205. aa views prototypes imageButton _AddSlots: (|
  206.     _ parent*                 = aa views traits imageButton.
  207.     iBitmapName <- 'Divide'.
  208.     bitmap.
  209. |)
  210.  
  211. ":=(TRAITS DEFINITIONS)=:aa views editorButtons "
  212. aa views editorButtons _Define: (|
  213.     quitButton                = ().
  214.     substituteButton            = ().
  215.     areaSelectionButton            = ().
  216.     allButtons <- list copy.
  217. |)
  218.  
  219. aa views editorButtons quitButton _Define: aa views textButton.
  220. aa views editorButtons quitButton _AddSlots: (|
  221.     iLabel <- 'quit'.
  222.     buttonNum <- 1.
  223.     performAction = (
  224.     topView unmap.
  225.     topView manager close.
  226.     ).
  227. |)
  228.  
  229. aa views editorButtons substituteButton _Define: aa views textButton.
  230. aa views editorButtons substituteButton _AddSlots: (|
  231.     iLabel <- ' <- '.
  232.     buttonNum <- 2.
  233.     performAction = (
  234.     topView captionText: 'Please select the thing to substitute.'.
  235.     topView handlerForNextWindow: aa editor substitutionSelectionEventHandler.
  236.     ).
  237. |)
  238.  
  239. aa views editorButtons areaSelectionButton _Define: aa views textButton.
  240. aa views editorButtons areaSelectionButton _AddSlots: (|
  241.     iLabel <- 'area'.
  242.     buttonNum <- 3.
  243.     performAction = (
  244.     topView handlerForNextWindow: aa editor areaSelectionHandler.
  245.     ).
  246. |)
  247.  
  248. aa views editorButtons allButtons add: aa views editorButtons quitButton.
  249. aa views editorButtons allButtons add: aa views editorButtons areaSelectionButton.
  250. aa views editorButtons allButtons add: aa views editorButtons substituteButton.
  251.  
  252.